#!/bin/sh
# examples.tcl \
exec tclsh "$0" ${1+"$@"}
 ##+##########################################################################
 #
 # pastel.tcl
 # by Keith Vetter
 #
 # Revisions:
 # KPV Nov 06, 2003 - initial revision
 #  RT Oct 18, 2004 - a button to view 12 pastels side-by-side
 #
 ##+##########################################################################
 #############################################################################
package provide utils 1.0

package require Tk

 proc DoDisplay {} {
    frame .f2 -bd 2 -relief ridge
    label .f -text "W" -font {Times 48}
    label .rgb -textvariable rgb

    button .pastel -text "Pastel" -command RandomPastel
    button .light -text "Light" -command RandomLight
    button .see12 -text "P 12" -command See12Pastel
    grid .f2 .pastel
    grid ^ .light
    grid ^ .see12
    grid .f -in .f2
    grid .rgb -in .f2
    grid columnconfigure . 1 -pad 10
    RandomPastel
 }

 ##+##########################################################################
 #
 # LightColor -- returns a "light" color. A light color is one in
 # which the V value in the HSV color model is greater than .7. Since
 # the V value is simply the maximum of R,G,B we simply need at least
 # one of R,G,B must be greater than .7.
 #
 proc LightColor {} {
    set light [expr {255 * .7}]                 ;# Value threshold
    while {1} {
        set r [expr {int (255 * rand())}]
        set g [expr {int (255 * rand())}]
        set b [expr {int (255 * rand())}]
        if {$r > $light || $g > $light || $b > $light} break
    }
    return [format "\#%02x%02x%02x" $r $g $b]
 }
 ##+##########################################################################
 #
 # Pastel -- returns a "pastel" color. Code is from X Windows tool xcolorize
 # Pick "random" color in a subspace of the HSV color model and convert to RGB.
 #
 proc Pastel {} {
    set rand [expr {rand() * 262144}]
    set h [fmod $rand 360]
    set rand [expr {$rand / 359.3}]
    set s [expr {([fmod $rand 9] + 12) / 100.0}]
    set v 1

    # Convert to rgb space
    if {$h == 360} { set h 0 }
    set h [expr {$h/60}]
    set i [expr {int(floor($h))}]
    set f [expr {$h - $i}]
    set p1 [expr {$v*(1-$s)}]
    set p2 [expr {$v*(1-($s*$f))}]
    set p3 [expr {$v*(1-($s*(1-$f)))}]
    switch -- $i {
        0 { set r $v  ; set g $p3 ; set b $p1 }
        1 { set r $p2 ; set g $v  ; set b $p1 }
        2 { set r $p1 ; set g $v  ; set b $p3 }
        3 { set r $p1 ; set g $p2 ; set b $v  }
        4 { set r $p3 ; set g $p1 ; set b $v  }
        5 { set r $v  ; set g $p1 ; set b $p2 }
    }
    foreach a {r g b} { set $a [expr {int ([set $a] * 255)}] }
    return [format "\#%02x%02x%02x" $r $g $b]
 }
 proc fmod {num mod} {                           ;# Floating point modulus
    foreach {int frac} [split $num "."] break
    set frac "0.$frac"
    return [expr {($int % $mod) + $frac}]
 }

 proc RandomLight {} {
    set ::rgb [LightColor]
    .f config -bg $::rgb
 }
 proc RandomPastel {} {
    set ::rgb [Pastel]
    .f config -bg $::rgb
 }

 ##+##########################################################################
 #
 # See12Pastel - generate a list of pastels and pass to display proc
 # ShowColorLIst - show side by side list of colors with RGB labels
 #
 proc See12Pastel {} {
     for {set i 0} {$i < 12} {incr i} {
         lappend clist [Pastel]
     }
     ShowColorList $clist
 }
 proc ShowColorList {list} {
     set tl .colorlist
     if {[winfo exists $tl]} {
         eval destroy [winfo children $tl]
     } else {
         toplevel $tl
     }
     set column 0
     foreach c $list {
         grid [label $tl.lc$column -bg $c] -column $column -row 0  -sticky news
         grid [label $tl.lt$column -text $c] -column $column -row 1
         incr column
     }
 }
 DoDisplay